home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hack-Mag 6
/
Hack-Mag - Issue 6 (1991-09-22)(D-Tect)(PD).adf
/
3DStars.s.pp
/
3DStars.s
Wrap
Text File
|
2014-06-20
|
9KB
|
396 lines
***************************************************************************
*** 3D Star Routine (c) 1990 by McDeal/D-TECT ***
*** This is a (Master-) Devpac source! ***
***************************************************************************
opt o+
*** Use joystick to control the stars !!! ***
* The control of the stars is lame, I know! I had a better version but the
* source would have been bigger so I decide to use this version. (The other
* included a x,y,z rotation with matrix calculation, etc.)
* Don't forget to press the firebottom!!!
PlaneHeight = 255
PlaneWidth = 40
PlaneLen = PlaneHeight*PlaneWidth
PL = PlaneLen
PlaneBLTSIZE = 3*PlaneHeight*64+(PlaneWidth/2)
MaxTiefe = $2000
StarCount = 335
X = 160
Y = 128
Z = 256
ClipX = 319
ClipY = 254
JoySpeed = 5
***************************************************
*** MACRO-Definition ***
***************************************************
WAITBLITT: MACRO
btst #6,$02(a6)
.\@: btst #6,$02(a6)
bne.s .\@
ENDM
***************************************************
*** ProgrammStart ***
***************************************************
section a,code_c
Start: lea $dff000,a6
move.w #$4000,$9a(a6)
bsr RandomStars
bsr.s CalcTab
bsr.s MakePerspTab
bsr.s StartCopper
bsr Main
bsr.s StopCopper
move.w #$c000,$9a(a6)
moveq #0,d0
rts
***************************************************
*** Copper Init ***
***************************************************
StartCopper: move.w #$0780,$96(a6)
move.l #NCList,$84(a6)
clr.w $8a(a6)
move.w #$8380,$96(a6)
rts
StopCopper: move.w #$0380,$96(a6)
clr.w $88(a6)
move.w #$8380,$96(a6)
rts
***************************************************
*** Build Y Table ***
***************************************************
CalcTab: lea YTab(pc),a0
moveq #0,d0
move.w #PlaneHeight-1,d7
.Loop: move.w d0,(a0)+
add.w #PlaneWidth,d0
dbra d7,.Loop
rts
***************************************************
*** Build Division Table ***
***************************************************
MakePerspTab: lea PerspTab,a1
move.w #Z,d0
add.w d0,a1
add.w d0,a1
move.w #Z,d2
mulu #$7fff,d2
.Loop: move.l d2,d1
divu d0,d1
move.w d1,(a1)+
addq.w #1,d0
cmp.w #MaxTiefe,d0
bne.s .Loop
rts
***************************************************
*** Random Stars ***
***************************************************
RandomStars: lea StarDatas,a0
move.w #$1fff,d3
move.w #StarCount-1,d7
.Loop: bsr.s GetWord ;X Word
add.w #X,d2
and.w d3,d2
sub.w #X,d2
move.w d2,(a0)+
bsr.s GetWord ;Y Word
add.w #Y,d2
and.w d3,d2
sub.w #Y,d2
move.w d2,(a0)+
bsr.s GetWord ;Z Word
add.w #Z,d2
and.w d3,d2
sub.w #Z,d2
move.w d2,(a0)+
dbf d7,.Loop
rts
GetWord: bsr.s GetByte
move.b d0,d2
lsl.w #8,d2
bsr.s GetByte
move.b d0,d2
rts
GetByte: move.b $dff007,d0
move.b $bfd800,d1
eor.b d1,d0
moveq #0,d1
move.b d0,d1
ror.b #1,d1
.loop: dbf d1,.loop
rts
***************************************************
*** Main Loop ***
***************************************************
Main: btst #10,$16(a6)
beq.s Main
move.l $04(a6),d0
and.l #$1ff00,d0
cmp.l #300*256,d0
bne.s Main
bsr ClearPlane
bsr JoyControl
bsr.s New3DStars
lea $dff000,a6
bsr ChangePlanes
move.w #$444,$180(a6)
moveq #20,d7
.Loop: dbra d7,.Loop
move.w #$000,$180(a6)
btst #6,$bfe001
bne.s Main
WAITBLITT
rts
***************************************************
*** 3D Star Routine ***
***************************************************
New3DStars: move.w #StarCount-1,d7 ;64 Stars
lea StarDatas,a0 ;Ptr StarDatas
lea PerspTab,a1 ;Projection Table
movem.w XAdd(pc),a4-a6 ;Put coordinate adds in regs
move.w #ClipX,a3 ;Clipping constante
move.w #ClipY,d5
move.w #$1fff,d3
move.w #$1000,d4 ;middle value
add.w d4,a4 ;+x add
add.w d4,a5 ;+y add
.Loop: movem.w (a0),d0-d2 ;Get coordinate
add.w a4,d0 ;add middle and de/increase x
and.w d3,d0 ;check overflow
sub.w d4,d0 ;sub middle
add.w a5,d1 ;add middle and de/increase y
and.w d3,d1 ;check overflow
sub.w d4,d1 ;sub middle
add.w a6,d2 ;de/increase z
and.w d3,d2 ;check overflow
movem.w d0-d2,(a0) ;save coords
addq.w #6,a0 ;(there is no movem.w d0,(a0)+)
; >--- Projection, vlipping und plot
;/
.SetStar: cmp.w #Z,d2 ;z<d2?
blt.s .Next ;-> Next star
add.w d2,d2 ;Z*2
move.w (a1,d2.w),d6 ;Projektionswert holen
;It's very important to do the following commands in this order. It's very
;stupid of you do it like this:
; muls d6,d0
; muls d6,d1
; swap d0
; swap d1
; etc...
;Ok, the source looks better but there is one BIG disadvantage!!! If e.g.
;the x value isn't in the screen you don't have the plot this pixel. But
;if the pixel musn't be plot it is really stupid to check/calculate the
;y value!!! Understood??? The following routine is much better! It first
;checks if the x value is within the screen. If it is, the y value will be
;calculated. If not, the y value won't be calculated (We can't save the
;unneccessary 'muls d6,d1' in this case!!!
muls d6,d0 ;projection
swap d0 ;
add.w #X,d0 ;X middle of screen (160)
cmp.w a3,d0 ;a3=ClipX (Clipping)
bhi.s .Next ;Don't plot
muls d6,d1 ;projection
swap d1
add.w #Y,d1 ;Y middle of screen (128)
cmp.w d5,d1 ;a4=ClipY
bhi.s .Next ;Don't plot
move.l WorkPlane(pc),a2 ;plot pixel
move.w d0,d6
lsr.w #3,d6
add.w d6,a2
add.w d1,d1
add.w YTab(pc,d1.w),a2
not.w d0
rol.w #6,d2 ;get color
and.w #$e,d2
move.w .JT(pc,d2.w),d2
jmp .JT(pc,d2.w)
.JT: dc.w .r6-.JT,.r6-.JT,.r5-.JT,.r4-.JT
dc.w .r3-.JT,.r2-.JT,.r1-.JT,.r0-.JT
.r0: bset d0,(a2) ;plot routines...
.next: dbf d7,.Loop
rts
.r1: bset d0,PL(a2)
dbf d7,.Loop
rts
.r2: bset d0,(a2)
bset d0,PL(a2)
dbf d7,.Loop
rts
.r3: bset d0,PL*2(a2)
dbf d7,.Loop
rts
.r4: bset d0,(a2)
bset d0,PL*2(a2)
dbf d7,.Loop
rts
.r5: bset d0,PL(a2)
bset d0,PL*2(a2)
dbf d7,.Loop
rts
.r6: bset d0,(a2)
bset d0,PL(a2)
bset d0,PL*2(a2)
dbf d7,.Loop
rts
XAdd: dc.w 0
YAdd: dc.w 0
ZAdd: dc.w -100
YTab: ds.w PlaneHeight
***************************************************
*** Joystick Control ***
***************************************************
JoyControl: lea XAdd(pc),a0
lea ZAdd(pc),a1
tst.b $bfe001 ;Y or Z?
bpl.s .Pressed ;Z-> Pressed
lea YAdd(pc),a1 ;otherwise Y
.Pressed: move.w $0c(a6),d0
btst #1,d0
beq.s .TstLinks
subq.w #JoySpeed,(a0)
bra.s .DoY
.TstLinks: btst #9,d0
beq.s .DoY
addq.w #JoySpeed,(a0)
.DoY: move.w d0,d1
lsr.w #1,d1
eor.w d0,d1
btst #0,d1
beq.s .TstVorne
addq.w #JoySpeed,(a1)
bra.s .Exit
.TstVorne: btst #8,d1
beq.s .Exit
subq.w #JoySpeed,(a1)
.Exit: rts
***************************************************
*** clear DelPlane ***
***************************************************
ClearPlane: WAITBLITT
move.l DelPlane(pc),$54(a6)
clr.w $66(a6)
move.l #$01000000,$40(a6)
move.w #PlaneBLTSIZE,$58(a6)
rts
***************************************************
*** Tripple Buffering ***
***************************************************
ChangePlanes: lea Plane(pc),a0
movem.l (a0),d0-d2
exg d0,d1
exg d1,d2
movem.l d0-d2,(a0)
lea PlanePtrs(pc),a0
move.w d0,6(a0)
swap d0
move.w d0,2(a0)
swap d0
add.l #PlaneLen,d0
move.w d0,6+8(a0)
swap d0
move.w d0,2+8(a0)
swap d0
add.l #PlaneLen,d0
move.w d0,6+16(a0)
swap d0
move.w d0,2+16(a0)
swap d0
rts
Plane: dc.l Plane1
WorkPlane: dc.l Plane2
DelPlane: dc.l Plane3
***************************************************
*** Datas ***
***************************************************
* Try Germany/0+$4498a7c!!! (Ask for Karsten!)
NCList: dc.l $01200000,$01220000,$01240000,$01260000
dc.l $01280000,$012a0000,$012c0000,$012e0000
dc.l $01300000,$01320000,$01340000,$01360000
dc.l $01380000,$013a0000,$013c0000,$013e0000
dc.l $008e2c81,$00902bc1,$00920038,$009400d0
dc.l $01020000,$01040000,$01080000,$010a0000
dc.l $01000200
PlanePtrs: dc.l $00e00000,$00e20000,$00e40000,$00e60000
dc.l $00e80000,$00ea0000
dc.l $01003200
dc.l $01800000,$01820333,$01840555,$01860777
dc.l $01880999,$018a0bbb,$018c0ddd,$018e0fff
dc.l -2
***************************************************
*** BSS Data segment ***
***************************************************
section b,bss_c
Plane1: ds.b PlaneLen*3
Plane2: ds.b PlaneLen*3
Plane3: ds.b PlaneLen*3
PerspTab: ds.w MaxTiefe
StarDatas: ds.w StarCount*3